home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / extmem.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  1.5 KB  |  51 lines
  1.       subroutine extmem(ipntr,ksize)
  2.       implicit double precision (a-h,o-z)
  3.       dimension ipntr(1)
  4. c spice version 2g.6  sccsid=memmgr 3/15/83
  5.       common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl,
  6.      1   ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4,
  7.      2   nwd8,nwd16
  8.       logical memptr
  9. c
  10. c***  extmem - extend size of existing block
  11. c
  12. c
  13. c...  check for valid pointer
  14.       if (memptr(ipntr(1))) go to 10
  15.       memerr=5
  16.       call errmem(2,memerr,ipntr(1))
  17.    10 isize=ksize*istack(ltab+5)
  18. c...  check for valid size
  19.       if (isize.ge.0) go to 20
  20.       memerr=2
  21.       call errmem(2,memerr,ipntr(1))
  22. c...  check if enough space already there
  23.    20 if ((istack(ltab+2)-istack(ltab+3)).ge.isize) go to 40
  24.       need=nxtevn(isize)-memavl
  25.       if (need.le.0) go to 30
  26. c...  insufficient space -- bump memory size
  27.       need=nxtmem(need)
  28.       icore=icore+need
  29.       call memory
  30.       if(memerr.ne.0) call errmem(2,memerr,ipntr(1))
  31.       ltab1=ldval-ntab
  32.       istack(ltab1+2)=istack(ltab1+2)+need
  33. c...  relocate block entry table
  34.       nwords=numblk*ntab
  35.       cpyknt=cpyknt+dble(nwords)
  36.       call copy4(istack(loctab+1),istack(loctab+need+1),nwords)
  37.       loctab=loctab+need
  38.       ldval=ldval+need
  39.       memavl=memavl+need
  40.       ltab=ltab+need
  41. c...  move blocks to make space
  42.    30 continue
  43.       call comprs(0,ltab)
  44.       call comprs(1,ltab)
  45.    40 jsize=istack(ltab+3)
  46.       istack(ltab+3)=istack(ltab+3)+isize
  47.       memavl=memavl-(nxtevn(istack(ltab+3))-nxtevn(jsize))
  48.       call memadj
  49.       return
  50.       end
  51.